home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / B-Business / (c)b2.d64 / bio-ploter.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  3KB  |  140 lines
  1. 1000 REM******************************
  2. 1010 REM*                            *
  3. 1020 REM*  THIS ADAPTATION FOR PET   *
  4. 1030 REM*                            *
  5. 1040 REM*            BY              *
  6. 1050 REM*                            *
  7. 1060 REM*       D. S. PENNER         *
  8. 1070 REM*                            *
  9. 1080 REM*      JUNE-ISH  1980        *
  10. 1090 REM*                            *
  11. 1100 REM******************************
  12. 1110 PRINT"[147]"
  13. 1120 AA$="        BIORHYTHM PLOTTER"
  14. 1130 AB$="ON ENTRY OF BIRTH DATE AND A STARTING"
  15. 1140 AC$="DATE, PLOTS A SHORT CHART [ 20 DAYS ]."
  16. 1150 AD$="TO CONTINUE ON; PRESS THE SPACE BAR."
  17. 1160 AE$="TO END; PRESS  Z ."
  18. 1170 AF$="TO START WITH A NEW DATE; PRESS  S ."
  19. 1180 PRINTAA$
  20. 1190 PRINT""
  21. 1200 PRINTAB$
  22. 1210 PRINT"";AC$
  23. 1220 PRINT"";AD$
  24. 1230 PRINT"";AE$
  25. 1240 PRINT"";AF$
  26. 1250 GETZ$:IFZ$=""GOTO1250
  27. 1260 DEF FNI(X)=SGN(X)*INT(ABS(X))
  28. 1270 DEF FNF(X)=X-FNI(X)
  29. 1280 DIM F(12),J(2),O$(51)
  30. 1290 K=2*(null)
  31. 1300 FORI=1TO12:READF(I)
  32. 1310 NEXT I
  33. 1320 DATA31,28,31,30,31,30,31,31,30,31,30,31
  34. 1330 PRINT"[147]"
  35. 1340 INPUT"BIRTH DATE: MM,DD,YYYY ";M1,D1,Y1
  36. 1350 M=M1:D=D1:Y=Y1:GOSUB 2360
  37. 1360 Q1=JD
  38. 1370 M2=M1:D2=D1:Y2=Y1
  39. 1380 GOSUB 1860
  40. 1390 PI=P2
  41. 1400 PRINT
  42. 1410 INPUT"STARTING DATE: MM,DD,YYYY ";M2,D2,Y2
  43. 1420 M=M2:D=D2:Y=Y2:GOSUB 2360
  44. 1430 Q2=JD:QF=Q2-Q1
  45. 1440 GOSUB 1860
  46. 1450 REM CALCULATES OFFSET
  47. 1460 X=M1:GOSUB1960
  48. 1470 JI=J2+D1+Y1*365
  49. 1480 IF J1<639723 THEN PI=8
  50. 1490 X=M2:GOSUB 1960
  51. 1500 J2=J2+D2+Y2*365
  52. 1510 IFJ2<639723 THENP2=8
  53. 1520 N1=Y2-.1
  54. 1530 O=J2-J1+INT(N1/4)-INT(Y1/4)-INT(N1/100)+INT(Y1/100)+INT(N1/400)-INT(Y1/400)
  55. 1540 IFM1>2THEN1570
  56. 1550 X=Y1:GOSUB2020
  57. 1560 O=O+X
  58. 1570 IFM2>3THEN 1600
  59. 1580 X=Y2:GOSUB 2020
  60. 1590 O=O+X
  61. 1600 REM PRINT HEADER
  62. 1610 PRINT"[147]"
  63. 1620 PRINTTAB(7);"DOWN";TAB(20);"CRITICAL";TAB(38);"UP"
  64. 1630 H$="----------------!----------------"
  65. 1640 PRINT TAB(7);H$
  66. 1650 REM SET F(2) TO 29 FOR LP YRS
  67. 1660 X=Y2
  68. 1670 F(2)=F(2)+X
  69. 1680 REM MAKA DE CHART
  70. 1690 Y=QF
  71. 1700 PRINT""
  72. 1710 FOR O=OTO O+19
  73. 1720 PRINTM2;"/";D2;TAB(23);"!"
  74. 1730 REM INCRUMENT THE DATE
  75. 1740 IF P2=8 THEN 1770
  76. 1750 P2=P2+1
  77. 1760 IF P2>7 THEN P2=1
  78. 1770 D2=D2+1
  79. 1780 IF D2>F(M2)THEN GOSUB 2350
  80. 1790 IF M2<13 THEN 1810
  81. 1800 M2=1:Y2=Y2+1
  82. 1810 X=Y2:F(2)=28
  83. 1820 GOSUB 2020
  84. 1830 F(2)=F(2)+X
  85. 1840 NEXT O
  86. 1850 GOTO 2100
  87. 1860 REM FINDA DE DAZE OF DE WEEK
  88. 1870 N1=M2+12*INT(.6+1/M2)
  89. 1880 N2=Y2-INT(.6+1/M2)
  90. 1890 N3=INT(13*(N1+1)/5)
  91. 1900 N4=INT(5*N2/4)
  92. 1910 N5=INT(N2/100)
  93. 1920 N6=INT(N2/400)
  94. 1930 N7=N3+N4-N5+N6+D2-1
  95. 1940 P2=N7-7*INT(N7/7)+1
  96. 1950 RETURN
  97. 1960 REM DAZE IN PAST MONTHS
  98. 1970 J2=0
  99. 1980 FOR I=1 TO X-1
  100. 1990 J2=J2+F(I)
  101. 2000 NEXT I
  102. 2010 RETURN
  103. 2020 REM CHECK FOR LEAP YR
  104. 2030 IF X/400-INT(X/400)=0THEN2060
  105. 2040 IF X/100-INT(X/100)=0THEN2080
  106. 2050 IFX/4-INT(X/4)<>0THEN2080
  107. 2060 X=1
  108. 2070 RETURN
  109. 2080 X=0
  110. 2090 RETURN
  111. 2100 O=Y
  112. 2110 PRINT""
  113. 2120 FOR O=OTO O+19
  114. 2130 X=(SIN(K*(O/23-INT(O/23)))*15)+24
  115. 2140 P=X
  116. 2150 PRINTTAB(P);"P"
  117. 2160 NEXT O
  118. 2170 O=Y
  119. 2180 PRINT""
  120. 2190 FOR O=OTO O+19
  121. 2200 X=(SIN(K*(O/33-INT(0/33)))*15)+24
  122. 2210 I=X
  123. 2220 PRINTTAB(I);"I"
  124. 2230 NEXT O
  125. 2240 O=Y
  126. 2250 PRINT""
  127. 2260 FOR O=OTO O+18
  128. 2270 X=(SIN(K*(O/28-INT(O/28)))*15)+24
  129. 2280 E=X
  130. 2290 PRINTTAB(E);"E"
  131. 2300 NEXT O
  132. 2310 GETZ$:IF Z$="" THEN 2310
  133. 2320 IF Z$="Z" THEN END
  134. 2330 IF Z$="S" THEN 1330
  135. 2340 O=O+20:QF=QF+20:GOTO 1600
  136. 2350 D2=1:M2=M2+1:RETURN
  137. 2360 YY=Y+FNI((M-14)/12):MM=13+12*FNF((M-14)/12)
  138. 2370 JD=D+FNI((367*MM+5)/12)+FNI(365.25*(YY+4712))-2.5
  139. 2380 RETURN
  140.